00100	C**** LOOP2.F4 *********
00200	C*** LOOP, SORT2, CODN, NALF, BAUTO, 
00300	C*** LTLLUP, XNOTE, UPDATE, NEWR,  RNX,
00500	C*** RCURVE
00600	
00700		SUBROUTINE LOOP(I,J,K,L,M,N)
00800		DIMENSION N(1)
00900		MM=M-L
01000		II=I+L
01100		JJ=J+L
01200		DO 1 NN=I+L,J+L,K
01300	1	N(NN)=N(NN+MM)
01400	CLOOP:	0		;	DO 1 NN=I+L,J+L,K
01500	C	MOVE	1,@4(16)
01600	C	SUB 	1,@3(16) 	; MM IS IN 1
01700	C	MOVE	2,@(16)
01800	C	ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
01900	C	MOVE	3,@1(16)
02000	C	ADD	3,@3(16)	;J+L
02100	C	HRRZI	5,@5(16)		; ADR. OF N
02200	C	ADDI	2,-1(5)		; N(II)  START
02300	C	ADDI	3,-1(5)		; N(JJ)  FINISH
02400	C	MOVE	4,@2(16)	;K
02500	C	JUMPL	4,LP3		; JUMP IF NEG. INCR.
02600	C	HRRM	1,.+1		; ADD IN MM  TO (2) AT LP1+1
02700	CLP1:	MOVE	6,(2)
02800	C	MOVEM	6,(2)		;N(NN)=N(NN+MM)
02900	C	CAIGE	2,(3)
03000	C	AOJA	2,LP1
03100	C	JRA	16,6(16)
03200	CLP3:	HRRM	1,.+1		; ADD IN MM  TO (2) AT LP2+1
03300	CLP2:	MOVE	6,(2)		;NEG. INCR.
03400	C	MOVEM	6,(2)
03500	C	CAILE	2,(3)
03600	C	SOJA	2,LP2
03700	C	JRA 	16,6(16)	;	END
03800		END
03900	
04000		SUBROUTINE SORT2(RPOS,M)
04100		DIMENSION RPOS(2,200)
04200		L=2
04300	3	J=-1
04400		RX=RPOS(1,L-1)
04500		DO 2 K=L,M
04600		IF(RPOS(1,K).GE.RX)GO TO 2
04700		RX=RPOS(1,K)
04800		J=K
04900	2	CONTINUE
05000		IF(J.LT.0)GO TO 4
05100		K=L-1
05200		N=0
05300	1	N=N+1
05400		X=RPOS(N,K)
05500		RPOS(N,K)=RPOS(N,J)
05600		RPOS(N,J)=X
05700		IF(N.EQ.1)GO TO 1
05800	C	CALL EXCH(RPOS(1,K),RPOS(1,J))
05900	C	CALL EXCH(RPOS(2,K),RPOS(2,J))
06000	4	L=L+1
06100		IF(L.LE.M)GO TO 3
06200		END
06300	
06400		FUNCTION CODN(K,N)
06500		COMMON /PTR/KWDS(1) /XRN/RN(1)
06600	C GET CODE NUMBER AND RETURN POINTER
06700		N=KWDS(K)
06800		CODN=RN(N+1)
06900		END
07000	
07100		FUNCTION NALF(I)
07200	C CHANGE ASCII TO INTEGER
07300		IF(I.GE.0)GO TO 20
07400		J='A'
07500		M=-1
07600		GO TO 10
07700	20	J=' '
07800		M=16
07900	10	NALF=(I-J)/536870912-M
08000		END
08100	
08200		SUBROUTINE BAUTO(J,L,K,N)
08300	C  FOR AUTOMATIC BEAMS.
08400		COMMON /SC/JS,LS,MK,ISKP,XMINUS,NS,IEXP,LK,NNUM,JJ,JN,DBST
08500		1,NFLG,JXX,ISEMX,JG,VX(1)
08600		J=J+2
08700		VX(J-1)=L-N
08800	C**** A LIMIT OF 25 BEAMS PER LINE. ??
08900		VX(J)=K-N
09000		END
09100	
10900	
11500	
15500	
15600		SUBROUTINE LTLLUP(J,K,L,M)
15700		DIMENSION J(1)
15800		DO 1 N=L,M
15900	1	J(N)=J(N)+K
16000		END
16100	
16200		FUNCTION XNOTE(J)
16300		COMMON/XRN/RN(1) /SCM/V(78),ISCR,LCNT,RSTF
16400		1 /RINP/R(10,80),RPOS(2,50),RI(200) 
16500		1 /POSI/STFF(0/7),JJ2,IPOS /STF/RSTFAC(0/7),RSTJ2
16600		XNOTE=AMOD(R(4,J),100.)
16700		IF(XNOTE.GE.80)XNOTE=XNOTE-100
16800	C  FOR NEG. MINIS, ETC.
16900		A=R(10,J)
17000		IF(A.EQ.0)RETURN
17100		L=RSTF
17200		B=RSTFAC(L)
17300		K=1
17400		IF(A.EQ.2.)K=-1
17500	C THIS STAFF POS.
17600		XNOTE=XNOTE+(STFF(L)-STFF(L+K))/(-7.*B)
17700		END
17800	
17900	C CALLED FROM SLURZ, NEWR
18000		SUBROUTINE UPDATE(I)
18100		COMMON /LIMIT/LIMIT,ITEM,LL,IS /XRN/RN(1)
18200		RN(IS)=I
18300		IS=IS+I+3
18400		END
18500	
18600	C CALLED FROM SLURZ, SCMSS
18700		SUBROUTINE NEWR
18800		COMMON/PTR/PWDS(1)/LIMIT/LIMIT,ITEM,LL,IS,IX
18900		COMMON/XRN/RN(1) /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
19000		COMMON/SCX/JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
19100		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
19200		1 ,IXX,ISEMI,IQT,VX(50),IAMP,KQ,KN,M,MODE,IBLA
19300		1 /RINP/R(10,80),RPOS(2,50),RI(200) 
19400		IF(MODE.NE.1)GO TO 1
19500		IK=IS
19600		JIT=ITEM
19700	1	IS=IK
19800		ITEM=JIT+1
19900	C  MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
20000	C SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
20100	C  JUMP FOR BEAM CONT.
20200		K=1
20300	2	IEND=-1
20400		X=R(1,K)
20500		IF(X.EQ.1.)GO TO 11
20600		IF(X.NE.2.)GO TO 12
20700		IF(R(6,K).GE.0)GO TO 12
20800		IF(R(7,K).EQ.0)GO TO 32
20900	C  DELETE IF INVIS. REST AND NO RHYTHMIC VALUE.)
21000		GO TO 12
21100	11	IEND=0
21200	12	RN(IS+3)=0
21300		RN(IS+2)=0
21400	C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
21500		LK=10
21600		IF(MODE.GT.3)LK=8
21700	C ONLY LOOK AT 8 PARAMS AFTER MODE 3.
21800		DO 3 L=LK,1,-1
21900		A=R(L,K)
22000		IF(IEND.GE.0)GO TO 14
22100		IF(A.EQ.0)GO TO 3
22200		IEND=L
22300	14	RN(IS+L)=A
22400	3	CONTINUE
22500	13	RN(IS+2)=STAFF
22600		IF(X.NE.1)GO TO 4
22700		IEND=11
22800		RN(IS+11)=R(2,K)
22900	C GET P11 VALUE
23000	4	IF(IEND.LT.3)IEND=3
23100		IF(X.NE.1.)GO TO 34
23200		IF(MODE.NE.3)GO TO 34
23300		X=IS+11
23400		R(9,K)=X
23500	34	CALL UPDATE(IEND-2)
23600	32	IF(K.GE.IZ)RETURN
23700		K=K+1
23800		GO TO 2
23900		END
24000	
25000	C ******* WILL SAVE UP TO PARAM 12 ONLY!
25100	
25200	C*** CALLED FROM SLURZ
25300		SUBROUTINE RNX(A,B,C,D,E,F,G,H,RI)
25400		COMMON /XRN/RN(1) /LIMIT/LIMIT,ITEM,LL,I
25500		RN(I)=A
25600		RN(I+1)=B
25700		RN(I+2)=C
25800		RN(I+3)=D
25900		RN(I+4)=E
26000		RN(I+5)=F
26100		RN(I+6)=G
26200		RN(I+7)=H
26300		RN(I+8)=RI
26400		END
26500	
26600	C*** CALLED FROM MAIN.
27800	
27900	C*** CALLED FROM RJED AND MAIN.
29000	C*** CALLED FROM SLURZ AND MAIN.
29100		FUNCTION RCURVE(R)
29200		DIMENSION R(1)
29300	C R(1) IS R3 WHEN CALL IS FROM MAIN.
29400		A=R(6)+1.
29500		B=R(4)-R(1)
29600		IF(A.GE.0)GO TO 1
29700		B=B+A+A
29800	1	B=B/25.
29900		RCURVE=ABS(R(3)-R(2))/10.+B+.9
30000		IF(R(5).LT.0)RCURVE=-RCURVE
30100		END
34400